---
title: | 
  Text Classification
subtitle: Introduction to Natural Language Processing
execute:
  echo: true
  eval: true
  output: true
---

This document aims at providing you with some example code to perform text classification. For a more detailed discussion on the topic consult the slides and the recordings of the class.

```{r}
#| echo: false
#| output: false
library(quanteda)
library(quanteda.textmodels) 
library(quanteda.textstats)
library(quanteda.textplots) 
library(precrec)
library(caret)
library(tidyverse)
library(RColorBrewer)
library(kableExtra)
library(e1071)
library(kernlab)
library(naivebayes)
library(grid)
library(gridExtra)

options(scipen = 99999)
```

# Creating Document Features

First, let us have a look at our data and the documents. The data set contains user movie reviews and a classification of those as positive or negative.

```{r}
set.seed(7)
load("data/imdb.rdata")
imdb_all <- imdb
imdb <- sample_n(imdb, 2000)

imdb |>
  filter(nchar(review) < 800 & nchar(review) > 200) |>
  filter(row_number() < 6) |>
  kbl() |> 
  kable_styling(
    html_font = "Century Gothic", 
    font_size = 14
    )
```

Using the Package `quanteda` we can create a tokens object and subsequently a document feature matrix, which we will need to train our model. In the process of doing so, we might remove punctuation, stop words, hyphens and other things.

```{r}
toks <- imdb$review |> 
  tokens(
    remove_punct = TRUE, 
    remove_separators = TRUE, 
    split_hyphens = FALSE, 
    what = "word"
    ) |> 
  tokens_remove(pattern = stopwords('english')) |>
  tokens_remove(pattern = c("br", "<", ">"))
  #tokens_split(separator = "-", remove_separator = TRUE) |>
  #tokens_wordstem() 
```

```{r}
dfm <- toks |>  
  dfm() |> # stem = T
  dfm_select(min_nchar = 2) |>
  dfm_trim(min_docfreq = 20) # min_termfreq = 0

dfm_data_frame <- convert(dfm, to = "data.frame")

dfm_data_frame |>
  filter(row_number() < 10) |>
  dplyr::select(1:10) |>
  kbl() |> 
  kable_styling(
    html_font = "Century Gothic", 
    font_size = 14
    ) 
```

let's have a look at often our features occur in the data.

```{r}
textstat_frequency(dfm) |>
  filter(row_number() < 17) |>
  kbl() |> 
  kable_styling(
    html_font = "Century Gothic", 
    font_size = 14
    )
```

```{r}
textplot_wordcloud(
  dfm,
  color = "#9C6B91",
  background = "transparent",
  fixed_aspect = T
  )
```

For a lot of other plots in `quanteda` look up <https://quanteda.io/articles/pkgdown/examples/plotting.html> .

# Naive Bayes

The `quanteda` package offers some implemented models for text classification which are optimized to work on sparse density matrices. Among those is a function for naive bayes.

```{r}
mod_nb <- textmodel_nb(
  x = dfm, 
  y = imdb$sentiment, 
  prior = "docfreq"
  )

imdb$predicted<- predict(
  mod_nb, 
  newdata = dfm, 
  type = "class"
  )
```

Confusion Matrix

```{r}
confusionMatrix(
  imdb$predicted, 
  factor(
    imdb$sentiment, 
    levels=c("positive", "negative")
    )
  )
```

As discussed in the slides, the coefficients from naive bayes are the probabilities that a given observation falls into a certain class, given the respective document feature. By extracting them we can learn which features have a high predictive power and are important to our model.

```{r}
coef_table <- as.data.frame(coef(mod_nb))
coef_table$names <- rownames(coef_table)

coef_table |>
  filter(row_number() < 10) |>
  kbl() |> 
  kable_styling(
    html_font = "Verdana", 
    font_size = 11, 
    full_width = F
    )
```

The prediction can easily be computed manually from the coefficient table: Suppose we observe a document that reads "I love this movie", then the prediction for the positive review class is given by $P(C_{pos} \mid f_{love},f_{movie}) = 0.0042 \times 0.0203$ which is higher than the probability for $P(C_{neg} \mid f_{love},f_{movie}) = 0.0020 \times 0.0257$, while the other words where omitted here as stop words. The naive bayes classifier would thus predict correctly that this is a positive review.

Notice that the absolute value of the probabilities does not mean too much here. As you can see the values for the feature "movie" is pretty high in both cases. However, the values are pretty similar, thus indicating that the word is kind of "neutral" to our prediction. The probabilities will thus be high for features that are meaningful to our prediction and for features that appear frequently. Ideally we would like to have words appearing frequently and being associated pretty consistently with just one class.

What about the word "like" in the coefficient table? Notice that stop words like "not" "don't" and "can't" were removed from our tokens. While those are not particularly meaningful in most applications, they are important for the "sentiment-style" analysis done here. We thus start an attempt to not exclude those by still dropping a few of the more meaningless stop words:

```{r}
mystopwords <- stopwords()[c(-89,-167,-174,-94,-81)]

toks <- imdb$review |> 
  tokens(remove_punct = TRUE, split_hyphens =F) |> 
  tokens_remove(pattern = phrase(mystopwords), valuetype = 'fixed') |>
  tokens_remove(pattern = c("br", "<", ">"))
```

Indeed the accuracy has improved now. This shows one huge advantage of using naive bayes: We can easily get an intuition about how it forms the prediction and maybe see why it is not performing well in some situations.

Also, the consequences of the "naive" assumption can be seen clearly from this example. Ideally we would not want to view the appearances of "not" and "good" as contributing independently to the prediction, since they have a specific meaning in combination. However, we can also see why the assumption is not such a huge drawback if we include the word "not" in our tokens, since it's occurence then is also likely to create a high probability for the negative review class. Another approach where we still use naive bayes and include the notion of important co-occurence is if we create a document feature that combines or interacts "not" and "good". We can look up the words that often occur in combination and might compound them to one document feature:

```{r}
toks |>
  textstat_collocations(min_count = 50) |>
  arrange(desc(count)) |>
  kbl() |> 
  kable_styling(
    html_font = "Verdana", 
    font_size = 11, 
    full_width = F
    ) 
  
kwic(toks, pattern = phrase(c("waste time"))) |>
  filter(row_number()<10) |>
  kbl() |> 
  kable_styling(
    html_font = "Verdana", 
    font_size = 11, 
    full_width = F
    ) 
```

Similarly, we can look at the observations where our prediction failed:

```{r}
pred_wrong <- imdb |>
  filter(predicted!=sentiment)

pred_wrong |>
  filter(row_number()<10) |>
  kbl() |> 
  kable_styling(
    html_font = "Verdana", 
    font_size = 11, 
    full_width = F
    ) 
```

Or identify meaningful and not meaningful features based on the coefficients:

```{r}
coef_table <- coef_table |>
  mutate(ratio = positive/negative) |>
  arrange(desc(ratio))

coef_table |>
  filter(row_number() < 10) |>
  kbl() |> 
  kable_styling(
    html_font = "Verdana", 
    font_size = 11, 
    full_width = F
    ) 
```

```{r}
neutral <- coef_table |> 
  filter(ratio < 1.05 & ratio > 0.95)

neutral |>
  kbl() |> 
  kable_styling(
    html_font = "Verdana", 
    font_size = 11, 
    full_width = F
    )
```

We can now adjust our tokens in a way we see fit to improve the prediction:

```{r, fig.height=4, fig.width=8}
dfm <- toks |> 
  tokens_compound(
    pattern = phrase(c(
      "waste time",
      "very good", 
      "much better", 
      "very well", 
      "not good", 
      "see movie", 
      "not must see", 
      "must see", 
      "don't like"
      )), 
    valuetype = 'fixed'
    ) |>
  tokens_wordstem() |>
  tokens_remove(pattern = phrase(neutral$names)) |>
  dfm() |>
  dfm_trim(min_docfreq = 10)
```

While this seems to be a sensible adjustment, did it change the performance of our prediction?

```{r}
mod_nb <- textmodel_nb(
  x = dfm, 
  y = imdb$sentiment, 
  prior = "docfreq"
  )

coef_table <- as.data.frame(coef(mod_nb))
coef_table$names <- rownames(coef_table)

imdb$predicted<- predict(
  mod_nb, 
  newdata = dfm, 
  type = "class"
  )

confusionMatrix(
  imdb$predicted, 
  factor(
    imdb$sentiment, 
    levels=c("positive", "negative")
    )
  )
```

Indeed the accuracy has improved. This shows one huge advantage of using naive bayes: We can easily get an intuition about how it forms the prediction and maybe see why it is not performing well in some cases. Adjusting document features might then improve the models prediction by a lot. However, compounding words manually might be a lot of work. An alternative would be to employ the n-grams methodology of creating tokens using `tokens_ngrams`.

A problem we have not yet addressed: If we get a set of new documents, there will likely appear new document features that have not been used in the training data. Whenever we encounter new data, we thus have to extract the columns that our model knows. Here, we want to predict the outcomes in the full data set, having only used a small fraction as the training data, to get a better picture of the predictive performance, since we did not use CV yet.

```{r}
toks_all <- imdb_all$review |> 
  tokens(remove_punct = TRUE, split_hyphens =F) |> 
  tokens_remove(pattern = phrase(mystopwords), valuetype = 'fixed') 

dfm_all <- toks_all |>
  tokens_compound(
    pattern = phrase(c(
      "waste time", 
      "very good", 
      "much better", 
      "very well", 
      "not good", 
      "see movie", 
      "not must see", 
      "must see"
      )), 
    valuetype = 'fixed'
    ) |>
  tokens_remove(pattern = phrase(neutral$names)) |>
  dfm() |>
  dfm_select(min_nchar = 2) |>
  dfm_trim(min_docfreq = 10)

dfm_all <- dfm_match(dfm_all, features = featnames(dfm))

imdb_all$predicted <- predict(mod_nb, dfm_all)
confusionMatrix(
  imdb_all$predicted, 
  as.factor(imdb_all$sentiment), 
  positive = "positive"
  )
```

To do cross validation, we can turn to the `caret` package again. Be aware however, that the package here uses a different implementation of the naive bayes classifier, that is not optimized for dealing with sparse density matrices and does not (by default) model the frequencies using a bernoulli or multinomial distribution (rather a gaussian). If we convert the now numeric features into factors however, it uses a multinomial distribution just like the quanteda classifier.

```{r}
dfm_data_frame <- convert(dfm, to = "data.frame")

grid <- expand.grid(usekernel=F, laplace=1, adjust=1)
control <- trainControl(
  method = "cv", 
  number = 5, 
  savePredictions = T, 
  classProbs = T, 
  summaryFunction = twoClassSummary
  )

mod_nb <- train(
  x = dfm_data_frame[,-1], 
  y = as.factor(imdb$sentiment),
  method = "naive_bayes", 
  metric = "ROC", 
  trControl = control, 
  tuneLength = 1, 
  tuneGrid = grid
  )

mod_nb
```

# Support Vector Machine

Now we want to try out if we can improve the performance by using support vector machine:

```{r}
# grid <- expand.grid(cost = c(0.25,0.5,1))
control <- trainControl(
  method = "cv", 
  number = 5, 
  savePredictions = T, 
  classProbs = T, 
  summaryFunction = twoClassSummary
  )

mod_svm <- train(
  x = dfm_data_frame[,-1], 
  y = as.factor(imdb$sentiment), 
  method = "svmLinear", 
  metric = "ROC", 
  trControl = control, 
  preProcess = c("center", "scale"), 
  na.action = na.pass
  ) #tuneGrid = grid, 

mod_svm
```

Using a radial kernel we now have two parameters we obtain:

```{r}
grid <- expand.grid(
  sigma = c(0.01, 0.1, 0.5), 
  C = c(0.25, 0.5, 1)
  )

control <- trainControl(
  method = "cv", 
  number = 5, 
  savePredictions = T, 
  classProbs = T,
  summaryFunction = twoClassSummary
  )

mod_svm <- train(
  x = dfm_data_frame[,-1], 
  y = as.factor(imdb$sentiment),
  method = "svmRadial",
  metric = "ROC", 
  trControl = control, 
  preProcess = c("center","scale"), 
  na.action = na.pass, 
  tuneGrid = grid
  ) 

mod_svm
```

As we can see, using a radial based support vector machine, does improve accuracy. However if we have a lot of (meaningful) features, the dimensionality is high and the linear separation also works well.
